home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Graphics Programming (2nd Edition) / Visual Basic Graphics Programming 2nd Edition.iso / Src / Ch12 / 2dPgon.cls < prev    next >
Text File  |  1999-06-17  |  7KB  |  229 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4.   Persistable = 0  'NotPersistable
  5.   DataBindingBehavior = 0  'vbNone
  6.   DataSourceBehavior  = 0  'vbNone
  7.   MTSTransactionMode  = 0  'NotAnMTSObject
  8. END
  9. Attribute VB_Name = "TwoDPolygon"
  10. Attribute VB_GlobalNameSpace = False
  11. Attribute VB_Creatable = False
  12. Attribute VB_PredeclaredId = False
  13. Attribute VB_Exposed = False
  14. Option Explicit
  15. ' Two-dimensional polygon object.
  16.  
  17. Implements TwoDObject
  18.  
  19. Private Declare Function Polygon Lib "gdi32" (ByVal hdc As Long, lpPoint As POINTAPI, ByVal nCount As Long) As Long
  20. Private Type POINTAPI
  21.     X As Long
  22.     Y As Long
  23. End Type
  24.  
  25. ' The object's points.
  26. Private m_NumPoints As Long
  27. Private m_Points() As POINTAPI
  28.  
  29. ' Invalid property-array index
  30. Private Const INVALID_INDEX = 381
  31.  
  32. ' Drawing properties.
  33. Private m_DrawWidth As Integer
  34. Private m_DrawStyle As DrawStyleConstants
  35. Private m_ForeColor As OLE_COLOR
  36. Private m_FillColor As OLE_COLOR
  37. Private m_FillStyle As FillStyleConstants
  38.  
  39. ' Draw the object in a metafile.
  40. Private Sub TwoDObject_DrawInMetafile(ByVal mf_dc As Long)
  41.     ' Make sure we have at least 2 points.
  42.     If NumPoints < 2 Then Exit Sub
  43.  
  44.     SetMetafileDrawingParameters Me, mf_dc
  45.  
  46.     ' Draw the polygon.
  47.     Polygon mf_dc, m_Points(1), NumPoints
  48.  
  49.     RestoreMetafileDrawingParameters mf_dc
  50. End Sub
  51. ' Return the object's DrawWidth.
  52. Public Property Get TwoDObject_DrawWidth() As Integer
  53.     TwoDObject_DrawWidth = m_DrawWidth
  54. End Property
  55. ' Set the object's DrawWidth.
  56. Public Property Let TwoDObject_DrawWidth(ByVal new_value As Integer)
  57.     m_DrawWidth = new_value
  58. End Property
  59.  
  60. ' Return the object's DrawStyle.
  61. Public Property Get TwoDObject_DrawStyle() As DrawStyleConstants
  62.     TwoDObject_DrawStyle = m_DrawStyle
  63. End Property
  64. ' Set the object's DrawStyle.
  65. Public Property Let TwoDObject_DrawStyle(ByVal new_value As DrawStyleConstants)
  66.     m_DrawStyle = new_value
  67. End Property
  68.  
  69. ' Return the object's ForeColor.
  70. Public Property Get TwoDObject_ForeColor() As OLE_COLOR
  71.     TwoDObject_ForeColor = m_ForeColor
  72. End Property
  73. ' Set the object's ForeColor.
  74. Public Property Let TwoDObject_ForeColor(ByVal new_value As OLE_COLOR)
  75.     m_ForeColor = new_value
  76. End Property
  77.  
  78. ' Return the object's FillColor.
  79. Public Property Get TwoDObject_FillColor() As OLE_COLOR
  80.     TwoDObject_FillColor = m_FillColor
  81. End Property
  82. ' Set the object's FillColor.
  83. Public Property Let TwoDObject_FillColor(ByVal new_value As OLE_COLOR)
  84.     m_FillColor = new_value
  85. End Property
  86.  
  87. ' Return the object's FillStyle.
  88. Public Property Get TwoDObject_FillStyle() As FillStyleConstants
  89.     TwoDObject_FillStyle = m_FillStyle
  90. End Property
  91. ' Set the object's FillStyle.
  92. Public Property Let TwoDObject_FillStyle(ByVal new_value As FillStyleConstants)
  93.     m_FillStyle = new_value
  94. End Property
  95.  
  96. ' Return the number of points.
  97. Public Property Get NumPoints() As Integer
  98.     NumPoints = m_NumPoints
  99. End Property
  100. ' Set the number of points.
  101. Public Property Let NumPoints(ByVal new_value As Integer)
  102.     m_NumPoints = new_value
  103.     If m_NumPoints < 1 Then
  104.         Erase m_Points
  105.     Else
  106.         ReDim m_Points(1 To NumPoints)
  107.     End If
  108. End Property
  109. ' Return an X coordinate.
  110. Property Get X(ByVal Index As Integer) As Single
  111.     If (Index < 1) Or (Index > NumPoints) Then
  112.         Err.Raise INVALID_INDEX, "TwoDPolygon.X"
  113.     End If
  114.  
  115.     X = m_Points(Index).X
  116. End Property
  117. ' Return a Y coordinate.
  118. Property Get Y(ByVal Index As Integer) As Single
  119.     If (Index < 1) Or (Index > NumPoints) Then
  120.         Err.Raise INVALID_INDEX, "TwoDPolygon.X"
  121.     End If
  122.  
  123.     Y = m_Points(Index).Y
  124. End Property
  125. ' Set an X coordinate.
  126. Property Let X(ByVal Index As Integer, ByVal new_value As Single)
  127.     If (Index < 1) Or (Index > NumPoints) Then
  128.         Err.Raise INVALID_INDEX, "TwoDPolygon.X"
  129.     End If
  130.  
  131.     m_Points(Index).X = new_value
  132. End Property
  133. ' Set a Y coordinate.
  134. Property Let Y(ByVal Index As Integer, ByVal new_value As Single)
  135.     If (Index < 1) Or (Index > NumPoints) Then
  136.         Err.Raise INVALID_INDEX, "TwoDPolygon.X"
  137.     End If
  138.  
  139.     m_Points(Index).Y = new_value
  140. End Property
  141.  
  142. ' Return this object's bounds.
  143. Public Sub TwoDObject_Bound(ByRef xmin As Single, ByRef xmax As Single, ByRef ymin As Single, ByRef ymax As Single)
  144. Dim i As Integer
  145.  
  146.     If NumPoints < 1 Then
  147.         xmin = 0
  148.         xmax = 0
  149.         ymin = 0
  150.         ymax = 0
  151.     Else
  152.         With m_Points(1)
  153.             xmin = .X
  154.             xmax = xmin
  155.             ymin = .Y
  156.             ymax = ymin
  157.         End With
  158.  
  159.         For i = 2 To NumPoints
  160.             With m_Points(i)
  161.                 If xmin > .X Then xmin = .X
  162.                 If xmax < .X Then xmax = .X
  163.                 If ymin > .Y Then ymin = .Y
  164.                 If ymax < .Y Then ymax = .Y
  165.             End With
  166.         Next i
  167.     End If
  168. End Sub
  169. ' Draw the object on the canvas.
  170. Public Sub TwoDObject_Draw(ByVal canvas As Object)
  171.     ' Make sure we have at least 2 points.
  172.     If NumPoints < 2 Then Exit Sub
  173.  
  174.     SetCanvasDrawingParameters Me, canvas
  175.  
  176.     ' Draw the polygon.
  177.     Polygon canvas.hdc, m_Points(1), NumPoints
  178. End Sub
  179. ' Initialize the object using a serialization string.
  180. ' The serialization does not include the
  181. ' ObjectType(...) part.
  182. Private Property Let TwoDObject_Serialization(ByVal RHS As String)
  183. Dim token_name As String
  184. Dim token_value As String
  185. Dim next_x As Integer
  186. Dim next_y As Integer
  187.  
  188.     InitializeDrawingProperties Me
  189.  
  190.     ' Read tokens until there are no more.
  191.     Do While Len(RHS) > 0
  192.         ' Read a token.
  193.         GetNamedToken RHS, token_name, token_value
  194.         Select Case token_name
  195.             Case "NumPoints"
  196.                 ' This allocates the m_X and m_Y arrays.
  197.                 NumPoints = CSng(token_value)
  198.                 next_x = 1
  199.                 next_y = 1
  200.             Case "X"
  201.                 X(next_x) = CSng(token_value)
  202.                 next_x = next_x + 1
  203.             Case "Y"
  204.                 Y(next_y) = CSng(token_value)
  205.                 next_y = next_y + 1
  206.             Case Else
  207.                 ReadDrawingPropertySerialization Me, token_name, token_value
  208.         End Select
  209.     Loop
  210. End Property
  211. ' Return a serialization string for the object.
  212. Public Property Get TwoDObject_Serialization() As String
  213. Dim txt As String
  214. Dim i As Integer
  215.  
  216.     txt = DrawingPropertySerialization(Me)
  217.     txt = txt & " NumPoints(" & Format$(NumPoints) & ")"
  218.     For i = 1 To NumPoints
  219.         With m_Points(i)
  220.             txt = txt & vbCrLf & "    X(" & Format$(.X) & ")"
  221.             txt = txt & " Y(" & Format$(.Y) & ")"
  222.         End With
  223.     Next i
  224.  
  225.     TwoDObject_Serialization = "TwoDPolygon(" & txt & ")"
  226. End Property
  227.  
  228.  
  229.